home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / s_to_z / tpack / splash.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  4.8 KB  |  179 lines
  1. unit Splash;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ExtCtrls
  8. , UserInfo;
  9.  
  10.  
  11. type
  12.   TSplashScreenForm = class(TForm)
  13.     Panel1: TPanel;
  14.     Image1: TImage;
  15.     Bevel1: TBevel;
  16.       {bevels are really weird! try doing anything with the image and you'll see what
  17.       i mean. that when opening/changing the dfm file with the editor can make a difference}
  18.     Label1: TLabel;
  19.     Label2: TLabel;
  20.     procedure FormDeactivate(Sender: TObject);
  21.   private
  22.     { Private declarations }
  23.     fTimer: TTimer;
  24.     fOnDeactivating:TNotifyEvent;
  25.     procedure TimerOff(Sender: TObject);
  26.   public
  27.     { Public declarations }
  28.     procedure ShowFor(PauseTime,FloatTime:Longint);
  29.     property OnDeactivating:TNotifyEvent read fOnDeactivating write fOnDeactivating;
  30.   end;
  31.  
  32.  TSplashScreen = class(TDialogShell) {see userinfo.pas for details}
  33.  private
  34.    fPauseTime: Longint;
  35.    fFloatTime: Longint;
  36.    fOnExecute:TNotifyEvent;
  37.    fOnDeactivating:TNotifyEvent;
  38.  protected
  39.    function GetTest:Boolean; override;
  40.  public
  41.    constructor Create(aOwner:TComponent); override;
  42.    procedure Execute; override;
  43.  published
  44.    property PauseTime:LongInt read fPauseTime write fPauseTime default 1000;
  45.    property FloatTime:LongInt read fFloatTime write fFloatTime default 200;
  46.    property OnDeactivating:TNotifyEvent read fOnDeactivating write fOnDeactivating;
  47.    end;
  48.  
  49. implementation
  50.  
  51. {$R *.DFM}
  52.  
  53. Type
  54.   TSplashFlag=(splInitialized,splInDCL);
  55.   TSplashFlags= set of TSplashFlag;
  56. Const
  57.   SplashFlags:TSplashFlags=[];         {1byte}
  58.   SplashScreen:TSplashScreenForm=nil;  {4bytes}
  59.  
  60. { This will make the form disappear, and get freed, when ANY other form or window pops up.}
  61.  
  62. procedure TSplashScreenForm.ShowFor(PauseTime,FloatTime:Longint);
  63. begin
  64.   Show;                        {bring up the form}
  65.   Update;                       {the display}
  66.   if PauseTime>0 then begin
  67.     fTimer:=TTimer.Create(self); {make a timer}
  68.     with fTimer do try
  69.       Enabled:=False;            {begin setting it}
  70.       Interval:=PauseTime;         {set duration and event}
  71.       OnTimer:=TimerOff;
  72.       Enabled:=True;             {start the time}
  73.       while Enabled do
  74.         Application.ProcessMessages;     {AND WAIT RIGHT HERE TILL THE PAUSE TIME IS UP}
  75.     finally
  76.       fTimer.Free;
  77.       fTimer:=nil;
  78.       end;
  79.     end;
  80.   if FloatTime>0 then begin
  81.     fTimer:=TTimer.Create(self); {make a timer}
  82.     with fTimer do begin
  83.       Enabled:=False;            {begin setting it}
  84.       Interval:=FloatTime;         {set duration and event}
  85.       OnTimer:=TimerOff;
  86.       Enabled:=True;             {start the time}
  87.       end;                       {DO NOT WAIT HERE BUT GO ON WITH OTHER INITS.}
  88.     end;
  89. end;
  90.  
  91. procedure TSplashScreenForm.TimerOff(Sender: TObject);
  92. begin
  93.   fTimer.Enabled:=False;
  94. end;
  95.  
  96. procedure TSplashScreenForm.FormDeactivate(Sender: TObject);
  97. begin
  98.   try
  99.     if assigned(fOnDeactivating) then
  100.       fOnDeactivating(Self); {can turn off the timer!}
  101.     if fTimer<>nil then
  102.       try
  103.         while fTimer.Enabled do
  104.           Application.ProcessMessages;
  105.       finally
  106.         fTimer.Free;
  107.         fTimer:=nil;
  108.         end;
  109.   finally
  110.     SplashScreen.Free;  {release the memory}
  111.     SplashScreen:= nil; {zero out the pointer}
  112.     end;
  113. end;
  114.  
  115. {}
  116.  
  117. constructor TSplashScreen.Create(aOwner:TComponent);
  118. begin
  119.   inherited create(aOwner);
  120.   fPauseTime:=1000;
  121.   fFloatTime:=200;
  122.   if not (csDesigning in ComponentState) then
  123.     Execute;
  124. end;
  125.  
  126. procedure TSplashScreen.Execute; {make the splash-screen form. it will free/nil itself.}
  127. begin
  128.   if SplashScreen=nil then
  129.     SplashScreen:= TSplashScreenForm.Create(nil);
  130.   With SplashScreen do begin
  131.     OnDeActivate:=FormDeactivate;
  132.     OnDeactivating:=Self.OnDeactivating;
  133.     if splInDCL in SplashFlags then
  134.       SplashScreen.Show {do not use timers while in a library}
  135.     else
  136.       SplashScreen.ShowFor(fPauseTime,fFloatTime);
  137.     end;
  138. end;
  139.  
  140.  
  141. function TSplashScreen.GetTest:Boolean;
  142. begin
  143.   Result:= Assigned(SplashScreen);
  144. end;
  145.  
  146. {}
  147.  
  148. function InDcl:Boolean;
  149. var
  150.  i:integer;
  151.  p:pchar;
  152. begin
  153.   Result:=False;
  154.   getmem(p,80);
  155.   try
  156.     i:=GetModuleFileName(hInstance,p,80);
  157.     Result:=StrPos(p,'.DCL')<>nil;
  158.   finally
  159.     FreeMem(p,80);
  160.     end;
  161. end;
  162.  
  163. procedure Initialize;
  164. begin
  165.   SplashFlags:=SplashFlags+[splInitialized];
  166.   if InDcl then
  167.     SplashFlags:=SplashFlags+[splInDCL] {store the flag so we can suppress delay during design}
  168.   else
  169.     with TSplashScreen.Create(nil) do   {tada!; make/free the _component_ that makes the form}
  170.       Free;
  171. end;
  172.  
  173. { Here's the call to automatically show the SplashScreen when this unit is initialized!}
  174. initialization
  175.   if not (splInitialized in SplashFlags) then
  176.     Initialize;
  177. end.
  178.  
  179.